تبادل لینک هوشمند یک جلوه گرافيكي فوق العاده جالب با عکس
با اين برنامه مي تونين دو تا تصوير رو روي هم بندازيد و حركت بدين
تصاويرتون بايد JPG باشه و بزرگ نباشه.دستورات زير رو در قسمت General فرم بنويسيد
Dim Image1 As IPictureDisp
Dim Image2 As IPictureDisp
Private Type Location
X As Integer
Y As Integer
End Type
Dim Image1Move As Integer
Dim Image2MoveX As Integer
Dim Image2MoveY As Integer
Dim Image1Local As Location
Dim Image2Local As Location
Const Operation = vbSrcAnd
دو تا عكس رو در مسير برنامه كپي كنيد اسمشون هم 1 و 2 باشه
كد زير برای Form_Load هست
("Set Image1 = LoadPicture(App.Path & "\Image1.jpg
("Set Image2 = LoadPicture(App.Path & "\Image2.jpg
With me
.Show
Refresh.
.AutoRedraw = True
.ScaleMode = vbPixels
End With
Image1Move = 1
Image2MoveX = 3
Image2MoveY = 3
Do
me.PaintPicture Image1, Image1Local.X, Image1Local.Y
me.PaintPicture Image1, Image1Local.X + me.ScaleWidth, Image1Local.Y
me.PaintPicture Image1, Image1Local.X, Image1Local.Y + me.ScaleHeight
me.PaintPicture Image1, Image1Local.X + me.ScaleWidth, Image1Local.Y + me.ScaleHeight
me.PaintPicture Image2, Image2Local.X, Image2Local.Y, , , , , , , Operation
me.PaintPicture Image2, Image2Local.X + me.ScaleWidth, Image2Local.Y, , , , , , , Operation
me.PaintPicture Image2, Image2Local.X, Image2Local.Y + me.ScaleHeight, , , , , , , Operation
me.PaintPicture Image2, Image2Local.X + me.ScaleWidth, Image2Local.Y + me.ScaleHeight, , , , , , , Operation
With Image1Local
.X = .X - Image1Move
.Y = .Y - Image1Move
If .X < -me.ScaleWidth Then .X = 0
If .Y < -me.ScaleHeight Then .Y = 0
End With
With Image2Local
.X = .X - Image2MoveX
.Y = .Y - Image2MoveY
If .X < -me.ScaleWidth Then .X = 0
If .Y < -me.ScaleHeight Then .Y = 0
If .X + me.ScaleWidth > me.ScaleWidth Then .X = -me.ScaleWidth
If .Y + me.ScaleHeight > me.ScaleHeight Then .Y = -me.ScaleWidth
End With
DoEvents
Loop
براي اينكه دستورات بالا داخل يک حلقه بي پايان قرار مي گيره بايد در رويداد كليك فرم بنويسيد
End
فرم رو زياد بزرگ نكنيد سعي كنيد تصويرها هم اندازه باشند و فرم هم اندازه تصوير ها
براي اينكه در حركت عكس ها تنوع ايجاد كنيم در رويداد MouseMove فرم دستور زير رو بنويسيد
Image2MoveX = Int(me.ScaleWidth \ 2 - X) \ 10
Image2MoveY = Int(me.ScaleWidth \ 2 - Y) \ 10
موفق باشید
*****************************
تا حالا دیدین کسی قلب خودش رو جلوی دیگران در بیاره
اما دیوید بلین جادوگر بزرگ امریکایی این کار رو کرد
http://www.ljava2.persiangig.com/audio/blaine.asf
برنامه اي كه با آن مي توان فايل اجرايي را باز كرد و سورسش را ديد
http://www.hot.ee/microtools4u/Versions/SourceEditor.zip
کرکش
http://ar.yahoo.com/*http://64.233.98.43/e-Lunatic/15.08.Source.Editor.v2.26.zip
يك فرم MDI پيشرفته
http://www.pscode.com/vb/scripts/ShowZip.asp?lngWId=1&lngCodeId=57502&strZipAccessCode=tp%2F%5B575020912
یک برنامه جالب برای بزرگ نمایی روی Desktop
http://download.mehrzad.net/Default.aspx?ID=2
*****************************
برگرفته از وبلاگ دوست عزیزم ناصر به نشانی http://www.nasservb.blogfa.com/
*****************************
مخفي كردن منوي Start
براي مخفي كردن منوي Start به يك تابع از كتابخانه user32.dll احتياج داريد
Option Explicit
Dim hwnd1 As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
حالا بايد دو تا دكمه براي مخفي و آشكار كردن منوي Startبه فرم اضافه كنيد
كد مخفي كردن Start
Hwnd1=FindWindow("Shell_traywnd","")
call SetWindowPos(Hwnd1,0,0,0,0,0,SWP_HIDEWINDOW)
كد ظاهر كردن Start
call SetWindowPos(Hwnd1,0,0,0,0,0,SWP_SHOWWINDOW)
*****************************
آيكون يك برنامه رو از كالبدش كشيد بيرون و به صورت فايل آيكون ذخيره كرد
اين آموزش از سري آموزشي كتابخانه قدرتمند Shell هست
يك ماژول به پروژه اضافه كنيد و كد زير را داخلش كپي كنيد
Public Const MAX_PATH = 260
Public Const SHGFI_DISPLAYNAME = &H200
Public Const SHGFI_EXETYPE = &H2000
Public Const SHGFI_SYSICONINDEX = &H4000 ' System icon index
Public Const SHGFI_LARGEICON = &H0 ' Large icon
Public Const SHGFI_SMALLICON = &H1 ' Small icon
Public Const ILD_TRANSPARENT = &H1 ' Display transparent
Public Const SHGFI_SHELLICONSIZE = &H4
Public Const SHGFI_TYPENAME = &H400
Public Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME _
Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX _
Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE
Public Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Public Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
psfi As SHFILEINFO, _
ByVal cbSizeFileInfo As Long, _
ByVal uFlags As Long) As Long
Public Declare Function ImageList_Draw Lib "comctl32.dll" _
(ByVal himl&, ByVal i&, ByVal hDCDest& _
,ByVal x&, ByVal y&, ByVal flags&) As Long
Public shinfo As SHFILEINFO
يه دكمه به برنامه اضافه كنيد و يك texbox و با دو تا picbox و دو تا برچسب
و اینکه نام picbox ها رو image1 و image2 قرار بدهید
آدرس فايل اجرايي را داخل texbox بنويسيد و در كد كليك دكمه كد زير را بنويسيد
Dim hImgSmall As Long
Dim hImgLarge As Long
Dim FileName As String
Dim r As Long
FileName$ = Text1.Text
hImgSmall& = SHGetFileInfo(FileName$, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
hImgLarge& = SHGetFileInfo(FileName$, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)
Label1.Caption = Left$(shinfo.szDisplayName, InStr(shinfo.szDisplayName, Chr$(0)) - 1)
Label2.Caption = Left$(shinfo.szTypeName, InStr(shinfo.szTypeName, Chr$(0)) - 1)
image1.Picture = LoadPicture()
image2.Picture = LoadPicture()
r& = ImageList_Draw(hImgSmall&, shinfo.iIcon, image1.hDC, 0, 0, ILD_TRANSPARENT)
r& = ImageList_Draw(hImgLarge&, shinfo.iIcon, image2.hDC, 0, 0, ILD_TRANSPARENT)
*****************************
چطور مي شه دكمه بستن پنجره در گوشه فرم رو غير فعال كرد
شايد غير فعال كرد دكمه هاي تمام صفحه و كمينه رو بلد باشين ولي
ديگه فرم خاصيت غير فعال كردن دكمه close رو نداره مگه كنترل بوكس فرم رو
برداريم يا اصلآ فرم رو از نوع بدون منوي بالا وتيتر انتخاب كنيم
ولي با اين كد مي تونين با داشتن تمام كنترل ها فقط دكمه كلوز رو غير فعال كنين
تابع زير رو تعريف كنيد
Public Const SC_CLOSE = &HF060
Public Const MF_BYCOMMAND = &H0
Public Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function DeleteMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Sub DisableXbutton(ByVal frmHwnd As Long)
Dim hMenu As Long
hMenu = GetSystemMenu(frmHwnd, 0&)
If hMenu Then
Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
DrawMenuBar (frmHwnd)
End If
End Sub
حالا كد زير رو داخل Form_Load بنويسيد
DisableXbutton (Me.hwnd)
*****************************
اين تابع مي تونه كليد هاي CRTL_ALT_Delete رو غير فعال كنه
البته حتما بايد سريع به حالت قبل برگردونيد چون موندن اين حالت زياد جالب نيست
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
(ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Const SPI_SCREENSAVERRUNNING = 97
حالا دو تا كامند به فرم اضافه كنيد به اسم هاي Desabled و Enabled
كد دكمه غير فعال كردن
Private Sub Disabled_Click()
Dim Ret As Long
Dim pOld As Boolean
Ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
End Sub
كد فعال سازي اين كليد ها بهتر است اين كدها را در Unload فرم نيز فراخواني كنيد
Private Sub EnableD_Click()
Dim Ret As Long
Dim pOld As Boolean
Ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)
End Sub
*****************************
اين كد رو هم توي پروژه ديگه تست كنيد - تاریخ فارسي
MsgBox WeekdayName(Weekday(Date), False, vbSunday) & ", " & VBA.MonthName(VBA.Month(Date)) & " " & Day(Date) & ", " & VBA.Year(Date), vbOKOnly + vbInformation, "The date"
*****************************
با اين تابع مي تونيد آيكون هاي روي دسكتاپ رو مخفي و ظاهر كنيد
اول فراخواني توابع
Option Explicit
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
بعد سه تا كامند براي ظاهر كردن آيكون ها مخفي كردن آنها و خروج از فرم بنويسيد
كد هر كدام اينطور است
Private Sub cmdDHide_Click()
Dim hWnd As Long
hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hWnd, 0
End Sub'--------------------------------
Private Sub cmdDShow_Click()
Dim hWnd As Long
hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hWnd, 5
End Sub'---------------------------------
Private Sub cmdExit_Click()
Me.Hide
End
End Sub'-------------------------------------
*****************************
برگرفته شده از وبلاگ دوست عزیزم ناصر به نشانی http://www.nasservb.blogfa.com/
*****************************
*****************************
اموزش یک کار جالب با فرم ها
تنها با دو خط كد ميتونيد جلوه اي رو بوجود بياريد كه فكرشم نمي كرديد. يك فرم رو توي يك فرم ديگه جابديد. استفاده هاي زيادي ميشه ازش كرد. مثلا ساخت نوار ابزارهايي مثل اوني كه فتوشاپ داره. راجع بهش فكر كنيد
اين هم كدش
Private Declare Function SetParent Lib "user32" ( _
ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Sub Form_Load()
SetParent Form2.hWnd, hWnd
Form2.Show
End Sub
*****************************
چطور مي توان كادر Brows Folder ويندوز رو ظا هر كرد
اين كادر استفاده ي بسيار زيادي در برنامه هاي كاربردي داره.وموقعي استفاده مي شه كه كار بر بايد يك پوشه رو (مثلآ براي نصب برنامه )انتخاب كنه
يك ماژول ايجاد كنيد و كد هاي زبر رابنويسيد
'------Typing New data For BrowsForm---------------------
Public Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
'---------------Conset For BrowsForm--------------------
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const BIF_DONTGOBELOWDOMAIN = 2
Public Const MAX_PATH = 260
'-----------------------Declareing API------------------------------------------
Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
حال در جايي كه مي خواهيد كادر ظاهر شود كد زير رابنويسيد
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
szTitle = "Select Folder... "
With tBrowseInfo
.hWndOwner = Me.hwnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
msgbox( sBuffer)
End If
در پايان خط م اقبل آخر با يك پيغام مسير انتخاب شده كاربر اعلام مي شود كه شما عزيزان مي توانيد آنرا به دلخواه تغيير دهيد
*****************************
چطور مي توان كادر خصوصيات Propertis مربوط به يك فايل را ظاهر كرد
كادر خصوصيات اكثرآ در نوشتن يك كاد آرشيو يا ليست فايل كاربرد دارد كه شما روي نام فايل راست كليك مي كنيد و اين گزينه را معمولآ در انتهاي ليست انتخاب مي كنيد واين كادر ظاهر ميشود نوشتن چنين كد هايي باعث حرفه شدن برنامه ي شما مي گردد
به ماژولمان كد هاي زير را اضافه كنيد
'------Typing New data For Propertis File---------------------
Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
'---------------Conset For Propertis Dialog-------------------
Public Const SEE_MASK_INVOKEIDLIST = &HC
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SEE_MASK_FLAG_NO_UI = &H400
Public Const ATTR_NORMAL = 0
Public Const ATTR_READONLY = 1
Public Const ATTR_HIDDEN = 2
Public Const ATTR_SYSTEM = 4
Public Const ATTR_VOLUME = 8
Public Const ATTR_DIRECTORY = 16
Public Const ATTR_ARCHIVE = 32
'-----------------------Declareing API------------------------------------------
Declare Function ShellExecuteEX Lib "shell32.dll" Alias _
"ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long
'-----------------------------------------------------------------------------------------
Public Function ShowFileProperties(filename As String, OwnerhWnd As Long) As Long
Dim SEI As SHELLEXECUTEINFO
With SEI
.cbSize = Len(SEI)
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
.hwnd = OwnerhWnd
.lpVerb = "properties"
.lpFile = filename
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = 0
.hInstApp = 0
.lpIDList = 0
End With
ShellExecuteEX SEI
ShowFileProperties = SEI.hInstApp
End Function
حالا هر فايلي را كه مي خواهيد خصوصيياتش نمايش داد شود به اين تابع به صورت زير ارسال كنيد-پاس دهيد
ShowFileProperties(FileName,Me.hwnd)
آموزش های اینده : مترجم (کامپایلر ) و برنامه اف تی پی
*****************************
چطور ميتوان سطل آشغال ويندوز رو خالي كرد
اگه بخوايد يك برنامه تقويت ويندوز بنويسيد به گزينه خالي كردن سطل آشغال ويندوز نياز خواهيد داشت
سري قبل اين اموزش رو در مورد كنترل سي پي يو (تاكس منيگر)ويندوز نوشتم
براي اين كار بايد از تابعي موجود در كتابخانه قدرتمند شل كه در آرشيو اموزشهاي زيادي راجع به اين كتابخانه هست استفاده كنيد
شيوه ي تعريف كتابخانه
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hWnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Const SHERB_NOPROGRESSUI = &H2
شيوه ي استفاده
Private Sub Command1_Click()
Dim retvaL
retvaL = SHEmptyRecycleBin(Form1.hWnd, "", SHERB_NOPROGRESSUI)
End Sub
*****************************
کنترل CPU خیلی جالبه
يک فرم ايجاد كنيد و يه هفت تا ليبل بزارين روش با يه تايمر و يه HScroll
خاصيت Max مربوط به اسكرول رو روي 100 بزارين
خاصيت Interval تايمر رو روي 50 بزارين
اين كدها رو اولين خط فرم بنويسيد
'----------Type New Data For Memory------------------
Private Type MEMORYSTATUS
dwlength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type '------------------Declear API Of Kernal Windows Librery-------------
Private Declare Sub GlobalMemoryStatus Lib "KERNEL32" (lpBuffer As MEMORYSTATUS)
Dim Mem As MEMORYSTATUS
روي تايمر دابل كليك كنيد و كد زير را بنويسيد
GlobalMemoryStatus Mem
Me.Caption = Mem.dwMemoryLoad & "% used"
Label1.Caption = "Memory used: " & Mem.dwMemoryLoad & "%"
Label2.Caption = "Total Physical Memory: " & Mem.dwTotalPhys
Label3.Caption = "Available Physical Memory: " & Mem.dwAvailPhys
Label4.Caption = "Page File Bytes: " & Mem.dwTotalPageFile
Label5.Caption = "Available bytes of Page File: " & Mem.dwAvailPageFile
Label6.Caption = "Total Virtual bytes: " & Mem.dwTotalVirtual
Label7.Caption = "Available Virtual Bytes: " & Mem.dwAvailVirtual
HScroll1.Value = Mem.dwMemoryLoad
با كداي بالا مي تونين كاركرد CPU و RAM رو مشاهده كنيد مثل خود ويندوز
*****************************
WindowsMediaPlayer
کنترل WindowsMediaPlayer که توسط کتابخانه قدرتمندي پشتيباني مي شود را مي توان در انواع ويندوز استفاده کرد
نحوه ي استفاده از کنترل. از منوي Components\WindowsMediaPlayer گزينه WindowsMediaPlayer را انتخاب کنید
قبل از اينکه آن کادر را ببنديد MicrosoftCommonDialog را هم انتخاب کنید
یک دکمه قرار دهید و کد زیر را درونش وارد کنید
CommonDialog1.ShowOpen
WindowsMediaPlayer1.URL=CommDialog1.FileName
مشاهده مي کنيد که کادر فايل باز شده و فايل انتخاب شده پخش مي شود
private sub Play_Click()
WindowsMediaPlayer1.Controls.Play()
End Sub
'------------------------
Prrivate Sub Stop_Click()
WindowsMediaPlayer1.Controls.Stop()
End Sub
'------------------------
Private Sub Pause_Click()
WindowsMediaPlayer1.Pause()
End Sub
یک تایمر به فرم اضافه کنید و یک HScroll1 و یک Lable
تايمر را به 50 تنظيم کنيد.روي تايمر دوبار کليک کنيد وکد زير را وارد کنید
Private sub Timer1_Timer()
Label1.Caption=WindowsMediaPlayer1.Controls.CurrentPositionString
HScroll1.max=WindowsMediaPlayer1.Controls.CurrentItem
HScrol1.Value=WindowsMediaPlayer1.Controls.CurrentPosition
End Sub
*****************************
اين هم تمام توابع موجود در فايل GDI32.Dll اين دستورات رو تو يه ماژول كپي كنيد
http://www.sharemation.com/MahdiVB678/new2/GDI32%20function.rar?uniq=yvs4wt
*****************************
فرمت فایل MP3
مبحث امروز كه ارتباط داره به خواندن اطلاعات اساسي فايل MP3.متغيير هاي زير رو تو اول كد تعريف كنيد
Dim HasTag As Boolean
Dim Tagg As String * 3
Dim Songname As String * 30
Dim Artist As String * 30
Dim Album As String * 30
Dim Year As String * 4
Dim Comment As String * 30
Dim Genre As String * 1
البته كد بالا تست شده است مورد كاملش اينهاست ولي نمي دونم جواب بده يانه خودتون امتحان كنيد اگه شد بهم بگيد -فعلآ استفاده نكنيد
Private Type MP3Tag
FullName As String ' Filename and filepath of MP3 file
FileName As String ' Name of MP3 file
Path As String ' Path of MP3 file
title As String * 30
artist As String * 30
album As String * 30
Year As String * 4
Comment As String * 30
Genre As String * 20
TagPresent As Boolean
MPEGVersion As String * 3 ' Version 1.0, 2.0 or 3.0
Layer As String * 1 ' Layer 1, 2 or 3
Protection As Boolean ' 0=CRC is present, 1=Not Protected
BitRate As String * 3 ' Recording bitrate
SampleRate As String * 5 ' Sampling Frequency
Padding As Integer ' 0=Frame is not padded, 1=(32bits for Layer 1, 8bits for Layer 2/3)
PrivateBit As Integer ' Not used. Do what you want with it
ChannelMode As String * 12 ' 00=Stereo, 01=Joint Stereo, 10=Dual Channel Stereo, 11=Mono
ModeExtension As String * 2 ' Used only for Joint Stereo
Copyright As Boolean ' Is file copyrighted?
Original As Boolean ' Is file on original media?
Emphasis As String * 8 ' Emphasis setting (usually none (00))
FrameLength As Integer ' Calculated from BitRate, SampleRate and Padding
TotalFrames As Long ' Filelength/Framelength
PlayTime As Single ' Calculated from TotalFrames, SampleRate and Stereo?
ValidHeader As Boolean ' True=Valid Header found, False=Not an MP3 file
End Type
بعد يك پروسيجر به اين صورت تعريف مي كنيم تاهر وقت بهش يك نام فايل پاس داديم متغيير هامون پر بشه از اطلاعت فايل
Private Sub GetTag(Filename)
Open Filename For Binary As #1
Get #1, FileLen(Filename) - 127, Tagg
If Not Tagg = "TAG" Then
Close #1
HasTag = False
Songname = "No Tag Found"
Artist = "No Tag Found"
Album = "No Tag Found"
Year = "None"
Comment = "No Tag Found"
Genre = "0"
Exit Sub
End If
HasTag = True
Get #1, , Songname
Get #1, , Artist
Get #1, , Album
Get #1, , Year
Get #1, , Comment
Get #1, , Genre
Close #1
End Sub
حالا به اين صورت ميشه ازش استفاده كرد
Me.GetTag(MP3 FileName)
به طور معمول وقتي فايل به صورت باينري باز مي شه چيزي جز صفر و يك رو نمشه از توش خواند به همين دليل اين نوع باز كردن فايل رو تصوير آينه وار حافظه مي گن.چون هر چي روي هارد نوشته همون رو دودستي تحويلت مي ده!از اين رو بايد هميشه بعد از خواندن اين نوع فايل ها اونارو از فرمت باينري در آورد با تابع زير كه ازقبل توي وي بي هست
Src(Your Ascii Word)
اگه رشته رو با(String *30)ولي در برنامه بالا چون اندازه رشته رو تعريف كرديم
يك كد اسكي مقدار دهي كنيم خود به خود هنگام چاپ به فرم رشته ي معمولي در مياد
در دستور بالا ما با علامت ضربدر به وي بي مي گوييم كه چه مقدار حافظه را براي متغيير ما نگه دارد ولي اگر اين مورد را استفاده نكنيم وي بي به صورت اتوماتيك سايز رشته رو انتخاب .ميكنه اگه رشته كم باشه كم واگر زياد باشه زياد براش جا نگه مي داره به ازاي هر حرف يك بايت
*****************************
چطور مي توان از Desktop عكس گرفت
اين خط رو در اولين خط كد فرم بنويسيد-براي مبتدي ها
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
طريقه استفاده
Private Sub Form_load()
Dim W, H
W = Screen.Width / 15
H = Screen.Height / 15
StretchBlt hdc, 0, 0, W, H, GetDC(0&), 0, 0, W, H, vbSrcCopy
End Sub
كشيدن يك دايره روي فرم با كد نويسي-نمودار دايره اي-بيضي
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
PI = 3.14159265
For i = 0 To 161 Step 10
Me.Circle (219, 167), i, RGB(0, 0, 0), 360 * (PI / 180), 360 * (PI / 180), 1
Next
End Sub
آنرا به 3 تغيير دهيد.داشتم مي گفتم پارامتر سوم براي شعاع دايره -اندازه آن-پارامتر چهارمscalmode توضيحات: پارامتر اول ودوم مكان ترسيم دايره اگر دايره در فرم شما رسم نشد خاصيت
براي رنگ پنجم براي نقطعه شروع وششم براي نقطه ي پايان اين دو تا براي رسم نمودار دايره اي بكار مي روند.پارامتر آخر هم براي رسم بيضي استفاده مي شود
چگونه مي توان يك مداد درست كرد مانند برنامه نقاشي ويندوز
كد زير را در MouseMove بنويسيد
If Button <> vbright Then Me.PSet (X, Y)
چطور مي توان يك قطره چكان درست كرد كه روي هر گزينه رفت رنگ پيش فرض رنگ انجا شود
عكس بنويسيدMouseMoveبه فرم اضافه كنيد يك عكس داخل كادر عكس قرار دهيد و كدزير را در رويدادPictureويكLabelيك
Label1.BackColor=Picture1.Point(X,Y)
چطور مي توان يك عكس را معكوس كرد
منظورت ازمعكوس اگه معكوس خود عكس در طراحي باشه كد زير جوابش هست
With Picture1
.PaintPicture .Picture, 0, .Height, .Width, -.Height
End With
ولي اگه منظورت معكوس رنگ باشه كد زير جوابش هست
With Picture1
.PaintPicture .Picture, 0, 0, , , , , , , vbDstInvert
End With
يراي موقعي به كار مي رود كه از يك اسم زياداستفاده مي كنيم.اسم را جلوي آن مينويسيم وهر وقت يك دات بزنيم قابل استفاده استWithتوضيحات:ِ
پارامتر اول يراي عكسي كه ميخواهيم از آن براي ترسيم استفاده كنيم.دوم و سوم براي نقطه شروع ترسيم .چهارم و پنجم براي اندازه تصوير ترسيمي.ششموهفتم براي نقطه پايان ترسيم.هشتم ونهم براي اندازه هاي پاياني ترسيم وپارامتر آخر براي نوع ترسيم
******************************
چطور ميشه يك عكس رو روشنتر كرد يا پر رنگ
Private Declare Function SetPixelV Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Byte
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
Private Sub CmdBrightness_Click()
'variables for brightness, color calculation, positioning
Dim Brightness As Single
Dim NewColor As Long
Dim x, y As Integer
Dim r, g, b As Integer
'change the brightness to a percent
Brightness = TxtBrightness / 100
'run a loop through the picture to change every pixel
For x = 0 To Picture1.ScaleWidth
For y = 0 To Picture1.ScaleHeight
'get the current color value
NewColor = GetPixel(Picture1.hDC, x, y)
'extract the R,G,B values from the long returned by GetPixel
r = (NewColor Mod 256)
b = (Int(NewColor / 65536))
g = ((NewColor - (b * 65536) - r) / 256)
'change the RGB settings to their appropriate brightness
r = r * Brightness
b = b * Brightness
g = g * Brightness
'make sure the new variables aren't too high or too low
If r > 255 Then r = 255
If r < 0 Then r = 0
If b > 255 Then b = 255
If b < 0 Then b = 0
If g > 255 Then g = 255
If g < 0 Then g = 0
'set the new pixel
SetPixelV Picture1.hDC, x, y, RGB(r, g, b)
'continue through the loop
Next y
'refresh the picture box every 10 lines (a nice progress bar effect)
If x Mod 10 = 0 Then Picture1.Refresh
Next x
'final picture refresh
Picture1.Refresh
End Sub
احتياج داريد كه متن درون آن به درصد برابر ميزان روشنايي استTxtBrightnessيك كادر متن به نامCmdBrightnessحال كردين با توضيحات كامل براي كد بالا يك كامند به نام
************************************
چگونگي زدن طیف رنگ (مثلآ سبز به سياه) به يك فرم
در رويداد فرم Load كد زير رابنويسيد
On Error GoTo B
Dim r%, F%, Heght%, Wath%, X%, Color$ '--\/\/\/ Set Color Of Form
Color = "Red_Black" '----------------تعيين تيف رنگ
Heigh = Me.Height + 200: Widt = Me.Width
F = Heigh \ 255: r = 0
Select Case Color
Case "Red_Black": GoTo 1
Case "With_Red": GoTo 2
Case "Green_Black": GoTo 3
Case "With_Green": GoTo 4
Case "Blue_Black": GoTo 5
Case "With_Blue": GoTo 6
Case "With_Black": GoTo 7
End Select
Exit Sub '---------------------------Main--------------------------------------------
1
For i = 0 To Heigh Step F
r = r + 1
If r = 20000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(250 - r, 0, 0)
Next X
Next i: GoTo B
2 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 20000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(250, 254 - r, 255 - r)
Next X
Next i: GoTo B
3 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 20000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(0, 250 - r, 0)
Next X
Next i: GoTo B
4 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 20000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(250 - r, 255, 255 - r)
Next X
Next i: GoTo B
5 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 255 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(0, 0, 250 - r)
Next X
Next i: GoTo B
6 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 20000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(250 - r, 250 - r, 255)
Next X
Next i: GoTo B
7 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 9000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(250 - r, 250 - r, 250 - r)
Next X
Next i '--------------------------------------------------------------------------------
B:
Set Me.Picture = Me.Image
ميتونيد اين كد رو خيلي كوتاه استفاده كنيد وهرخط چيني كه مربوط به رنگ خودتونه رو نگه داريد بقيه رو حذف كنيد.با كمي دقت مي توانيد رنگ هاي جديد بسازيد
*********************
چگونه ساعت ديجيتال بسازيم
كوتاهترين راه براي ساخت يك ساعت روش زير است يك Picturebox به فرم اضافه كنيد
Private Sub Form_Load()
Static Score As Long
Counter.Show
DoEvents
Score = 0
For I = 1 To 1265
DisplayNumber 10, Score
Score = I
DoEvents
Next
End Sub'-------------------------------------------------------------------
Private Sub DisplayNumber(DisplayWidth As Integer, TheNumber As Long)
Dim DisplayString As String, Zeros As Integer, GraphicsHeight As Single
Dim DigitValue As Integer, NumPosition As Integer
'--------------------Start Time---------------
GraphicsHeight = Picture1.ScaleHeight / 2
Zeros = DisplayWidth - Len(Trim(TheNumber))
For I = 0 To Zeros - 1
DisplayString = DisplayString & "0"
Next
DisplayString = DisplayString & Trim(Str(TheNumber))
For I = 0 To DisplayWidth - 1
DigitValue = Val(Mid(DisplayString, I + 1, 1))
If DigitValue = 0 Then NumPosition = 10 Else NumPosition = DigitValue _
Counter.PaintPicture Picture1.Image, I * (Picture1.ScaleWidth / 10), 0, _
Picture1.ScaleWidth / 10, Picture1.ScaleHeight / 2, (NumPosition - 1) _
* (Picture1.ScaleWidth / 10), GraphicsHeight, Picture1.ScaleWidth / 10, Picture1.ScaleHeight / 2
Next
End Sub
در كد بالا به دلايلي فرم خارج نمي شود بايد يك دكمه براي خروج از فرم تنظيم كنيدودر كد كليك آن بنوسيد
End
*****************************
كلاس چيست؟؟؟؟
كلاس يك مجموعه اي از كدهاست كه شبيه به يك كنترل هستند فقط شكل ظاهري و طراحي ندارند
كلاس ها شي هستند - يعني خاصيت دارند -كلاس ها مي توانند داخل خود پردازه يا تابع محلي وسراسري داشته باشند
كلاس به چه دردي مي خورد-كلاسها از تكرار كدها جلو گيري مي كنند -كلاس ها خوانايي برنامه را افزايش مي دهندوغيره
كلاس ها مي توانند به صورت خودكار خود را مقدار دهي كنند-يك ماژول كلاس ايجاد كنيد وكدهاي زير را در آن كپي كنيد
تعريف يك خاصيت در كلاس
'-----------Set Property Information---------
Public Poperty Let CWidth( Value As Integer)
CWidth=Value
End Property
'------------Get Property Information--------------
Public Property Get CWidth() As Integer
CWidth=CForm.Width
End Property
دستور اول خاصيت را مقدار دهي مي كند با مقداري كه كار بر فرستاده
دستور دوم براي دادن مقدار براي كابر است .البته هر كدام از اين دستورات را مي توان به صورت محلي استفاده كرد
وي بي با كلاس ها مانند يك نوع جديد رفتار مي كند يعني شما براي استفاده از يك كلاس در سطح فرم بايد يك متغير از
نوع كلاس تعريف كنيد .تعرف يك متغيير محلي در سطح فرم
Private CForm As Form
تمام متغيير ها وتوابع وپردازه ها وحتي نام خود كلاس را با سي آغاز كنيد تا معلوم شود مربوط به يك كلاس است
تعرف يك پردازه سراسري در كلاس
Private Sub CSetInfo(Frm As Form)
Set Form=Frm
End Sub
اگر تمام كدها بالا را درست در يك ماژول كلاس كپي كنيد اكنون نوبت استفاده از كدهاي بالاست
در خط اول فرم يك متغيير از نوع نام كلاس تعريف كنيد.بدين صورت
Dim Calss As Class1
Private Sub Form_Resiz()
Me.Caption="Form1.Width: "& Class.With
End Sub
*****************************
تنظيم ابعاد نمايش ويندوز براي يك برنامه اختصاصي
برنامه هاي سه بعدي از فضا نمي آيند توسط همين وي بي -دلفي واكثرآ سي پلاس پلاس طراحي مي شن وقتي يك بازي سه بعدي روباز مي كنيم ويك دفعه يك صفحه با گرافيكي كه تا حالا نديديم يه صورت زيبا بالا مي آد اكثر ما -بيشتر خودم- خيلي كف ميكنيم كه اين برنامه ها چطور ساخته مي شن-با چي ساخته مي شن
امروز مي خوام تنظيم ابعاد صفحه نمايش ويندوز رو با ابعاد دلخواه خودمون بگم كه گام اول طراحي سه بعديه اگه بشه شايد مراحل بعديش رو هم بزارم روي سايت كه مونده به ياري شما .بانظراتتون و خدا با توفيقش
ابتدا متغيير هاي اول فرم
Dim Dx As New DirectX7
Dim Dd As DirectDraw4
Dim clip As DirectDrawClipper
البته بعد از نوشتن كد بالا به منوي پروژه رفته گزينه ريفرنس رو انتخاب كنيد در منوي باز شده تيك گزينه ي دايركت ايكس 7 رو بزنيد
تا كد هاتون اجرا بشه روي فرم دابل كلاك كنيد و كد زير رو بنويسيد
Set Dd = Dx.DirectDraw4Create("")
Set clip = Dd.CreateClipper(0)
clip.SetHWnd Me.hWnd
' screen mode
Dd.SetDisplayMode 800, 600, 32, 0, DDSDM_DEFAULT
بااين كد صفحه نمايش به مد 800*600و حالت 32بايتي ميره
*****************************
دستور Shell
توسط اين دستور مي تونيد فايلي را در وي بي اجرا كنيد .آدرسي كه جلوي اين دستور نوشته مي شه اجرا ميشه .شكل اين دستور به اين صورت است
Shell ProgramPath,RunModel
در آرگومان اول مسير فايل نوشته مي شود ودر آرگومان دوم مدلي كه برنامه بايد اجرا شود.در اين ارگومان از آرگومان هاي زير استفاده مي گردد
vbHide=0 vbMaximizedFocus=1 vbMinimizedFocus=2 vbMinimizedNoFocus=3 vbNormalFocus=4 vbNormalNoFocus=5
در مدل صفر برنامه به صورت پنهان ظاهر مي شود.براي مواقعي كه مي خواهيم عمل اجرا را از ديد كاربر پنهان كنيم .در مدل 2 برنامه اجرا مي شود به صورت كمينه(روي منوي استارت-مينيمايز شده)وفاكس هم روي ان مي رود يعني اين كه بعد از اجرا هي زرد و آبي مي شود تا كار بر روي آن كليك كند.مدل 3برنامه به
صورت ينيمايز -كمينه اجرا مي شود زرد وآبي نمي شود (معمولي-فاكس رويش نمي رود).مدل 1برنامه به صورت تمام صفحه اجرا شده فاكس هم روي آن مي رود(زرد و ابي مي شود).در مدل 4برنامه با اندازه پيش فرض اجرا مي شودوفاكس را هم مي گيرد.درمدل 5برنامه با اندازه معمولي اجرا شده و فاكس نمي گيرد
كار برد مهم ديگر شل اجرا فايل هاي معمولي با يك برنامه اجرايي است مثل اجراي يك متن در نت پد.براي اين كار نام فايل را بايك فاصله از نام فايل مي نويسيم
Shell "NotPath.Exe"+" C:\Text1.txt" ,4
توجه داشته باشيد كه براي اجراي فايل بايد نام ومسير فيل را با يك كاراكتر فاصله بنويسيد
اگر فاصله ندهيد قطعآ خطا انجام مي شود.اگر فايلي در مسير برنامه تان كپي كرده ايد اين كد را بنويسيد
shell "notpath.exe"+(app.path+"\"+"your File Name")
كلاسي است كه به برنامه اشاره مي كند ومي توان اطلاعات برنامه مانند مسير-نام فايل اجرائي-كمپاني وغيرهapp
براي نوتپد ويندوز چون در درايو ويندوز قرار دارد احتياج به تايپ مسير كامل نيست همچنين اگر شما فايلي را از پوشه
اجرا كنيد به مسير كامل نياز نيست برنامه اي مانند كامند پرامپت بازي ها واسكرين سيور ها در اين پوشه system32
است.مثال hell "cmd.exe",4
اجراي يك فولدر با شل
واقع در درايو ويندوز را به همراه نام فيل اجرا مي كنيمexplorer.exeبراي اين كار فايل اجرائي
shell "explorer.exe"+" c:\windows" ,3
با اجراي اين برنامه پوشه ويندوز اجرا مي شود روش بالا در سي دي هاي اتوران استفاده ي زيادي دارد
Shell "rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl "كادر حذف برنامه ها
Shell "rundll32.exe shell32.dll,Control_RunDLL desk.cpl"كادر تغيير پس زمينه
Shell "rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl"كادر اينتر نت
Shell "rundll32.exe shell32.dll,Control_RunDLL modem.cpl"كادر مودم
Shell "rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl"كادر صدا
Shell "rundll32.exe shell32.dll,Control_RunDLL netcpl.cpl"كادر شبكه
Shell "rundll32.exe shell32.dll,Control_RunDLL powercfg.cpl"كادر پاور-برق
Shell "rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl"كادر سيستم
Shell "rundll32.exe shell32.dll,Control_RunDLL telephon.cpl"كادر تلفن
Shell "rundll32.exe shell32.dll,Control_RunDLL timedate.cpl"كادر ساعت
كتابخانه وسيع Shell
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal_ lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal_ nShowCmd As Long) As Long
كد هاي زير را هر جا استفاده كنيد جواب مي دهدالبته بهد از اينكه كد بالا را در اولين خط فرم نوشتيد
Shell "arp"
Shell "drvspace"
Shell "drwatson"
Shell "explorer"براي my document
Shell "freecell"
Shell "ftp"براي تنظيم اف تي پي
Shell "ipconfig"كادر آي پي
Shell "mplayer"مديا پلير
Shell "mshearts"
Shell "nbtstat"
Shell "netstat"
Shell "calc"ماشين حساب
Shell "notepad"نوت پد
Shell "packager"
Shell "pbrush"نقاشي
Shell "ping"
Shell "regedit"ريجيستري
Shell "route"روت
Shell "scandskw"اسكن ديسك
Shell "scanregw"اسكن رگ
Shell "setdebug"كخك تري تنظيم ويندوز
Shell "sigverif"
Shell "cdplayer"سي دي پلير
Shell "sndrec32"ضبط صدا
Shell "sndvol32"تنظيم ولوم صدا
Shell "sol"همون سول
Shell "taskman"وضعيت سي پي يو
Shell "telnet"تلفن
Shell "vcmui"
Shell "winfile"
Shell "winipcfg"
Shell "winmine"
Shell "winrep"
Shell "charmap"كاراكتر مپ
Shell "winver"
Shell "write"وورد پد
Shell "wscript"
Shell "cleanmgr"كلنر پاك كننده اشغال درايو
Shell "control"كنترل پنل
Shell "cvt1"
Shell "defrag"دفراگمنت
Shell "drvspace" فضاي خالي ديسك
اجراي فايل اينترنت با Shell
shell "Explorer.exe"+" http://www.VBLog.blogfa.comن به يك سايت
shell "explorer.exe"+" maileto:Mahdi_VBLog@yahoo.com"كادر ارسال ايميل
shell "explorer.exe"+" yor HTML File.html"كادر اجراي يك فايل اينترنت از حافظه
shell "explorer.exe"+" file://www.سايت شما.com/11.zip"كادردانلود يك فايل از اينترنت
*****************************
فرمت فایل M3U
چگونه یک فایل PlayList با پسوند M3U بسازیم
گاهي وقتي عده ي زيادي فايل را در مدیا پلير يا وينمپ باز مي كنيم يك گزينه به نام SavePlaylist
مي بينيم كه براي ذخيره كردن آن ليست در يك فايل استفاده مي شود.اگر يك برنامه ي پخش صوت يا تصوير باكنترل مديا پلير نيز بنويسيد براي پخش هم زمان چندين فايل به مشكل برخواهيد خورد .درچنين مواقعي مي توانيم با ذخيره ليست در يك فايل ام تري يو وباز كردن آن در كنترل مديا پلير چندين فايل را با هم پخش كرد .شايد شما بتوانيد فايل هايتان را مستقيمآ به ليست مديا پلير احتياج به دانستن فرمت فايل ام تري يو داريدPlayListاضافه كنيد ولي باز هم براي ذخيره
با اين تابع اين كار را انجام دهيد
Public Sub SaveList(OutPath As String,Lst as ListBox)
On Error Resume Next '--------------------------------------------------
Dim T3 As String, T2, strans As String, L As Single, i As Integer
T3 = "": T2 = ""
If Lst.List(1) = "" Then
strans = MsgBox("File Not Found!", vbCritical)
Exit Sub '------------------------------------------------------
End If
If UCase(Right(OutPath, 3)) <> "M3U" Then Exit Sub
Open OutPath For Output As #1
Print #1, "#EXTM3U:"
For i = 1 To Lst.ListCount '----------------------------
Print #1, "#EXTNIF:"
Print #1, Lst.List(i)
Next i '------------------------------------------------------
Close #1
End Sub
حال براي زخيره كردن فايل هاي صوتي و تصويري موجود در يك ليست تنها به دستور زير نياز داريد
SaveList "C:\1.M3U",List1
*****************************
برخي اپراتور هاي Visual Basic
Type Of اپراتور
اين اپراتور براي تشخيص نوع كنترل به كار مي رود.روش استفاده از ان به شكل زير است
TypeOf ControlName Is ControlType
مثال:كنترلي از نوع فايل بوكس رابه تايع زير مي فرستيم يراي تعيين عضو انتخاب شده
Private Function GetSelectItem(LST as Contol) as String
if TypeOf lst is listbox then
GetselectItem=Lst.text:Exit Function
else :GetselectItem=Lst.FileName:Exit Sub
End if
در خط يك تابع با آرگومان يك ليست از نوع كنترل تعريف مي شود خروجي تايپ آف به صورت يك منو مانند تعريف متغيير هنگام كد نويسي ظاهر مي شود كه شما مي توانيد نو ع كنترل خود را از داخل آن انتخاب كنيد.توجه كنيد بين تايپ و آف نبايد فاصله بيفتد واگر نه با خطاي كامپايل مواجه مي شويد.
DoEvents اپراتور
اين اپراتور براي ارجاع تمام عملييات به سي پي يو براي انجام مي باشد.اكثرآ از اين اپراتور براي مواقعي استفاده مي گردد كه يك عمليات وقتگير در حال انجام است مانند اعمال افكت روي تصوير و حلقه هاي تكرار طولاني. اين اپراتور در درون حلقه قرار گرفته و كامپايل نمي شود مانند رهنمود ها در پاسكال عمل مي كندوبه سي پي يو مي گويد تمام كارهيت را به صورت يكسان انجام بده واز اولويت ها صرف نظر كن .در برنامه هايي كه يك عمليات در درون يك حلقه هر دور انجام مي شود آكثرآ باعث هنك كردن آن برنامه تا پايان عمليات مي شود.چون برنامه بين واكنش به تكان خوردن موس -جابه جاكردن برنامه يا بزرگ و كوچك كردن برنامه وپردازش روي عمليات مورد نظر(مثلآ كپي فايل)عمليياتي كه داراي اولويت پردازش است را انتخاب مي كند.اين اپراتور در چنين مواقعي بسيار مفيد است وباعث مي شود كاربر گمان نكند كه برنامه هنك كرده و آن را ببندد.مثال:ِ
For i=0 to list1.listCount -1
if list1.list(i)<>"" then call Copy(list1.list(i),App.path+"\")
DoEvents
Next
در خط اول حلقه اي از صفر تا تعداد اعناصر موجود در ليست اغازمي شودو در هر درو فايل درون ليست در صورت وجود كپي مي شود .اگر فايل هاي مازياد باشد DoEventsو اپراتور را ننويسيم حتمآ برنامه ما هنك مي كند.بايد ياد آور شد استفاده نابجا و بيش از اندازه اين اپراتور موجب كاهش سرعت برنامه مي شود.ِالبته
استفاده مي كنندSleepبه نام APIباعث كاركرد زياد وشديد سي پي يو مي شود وبرخي ترجيح مي دهند از آن استفاده نكنند ويه جاي ان از يك
فرق مي كند. اسليپ باعث ميشود سي پي يو تمام كار هاي در حال اجرا را رها كند وبه مدت زماني كه جلويDoEventsبايد گفت كاركرد اسليپ به طور كلي با
آن نوشته مي شود به استراحت بپردازد.ِ
sleep با توجه به زماني كه براش تعيين ميكني در وسط كار برنامه مكث ايجاد ميكنه و در آن زمان هيچ خطي از كد برنامه اجرا نميشه و همان طور كه از اسم تابع .مشخصه برنامه در آن زمان به خواب ميره
اسليپ زماني كه با محيط خارج از برنامه در ارتباطي خيلي مفيده. چون معمولا وقتي دستوري در وي بي مثل اجراي فلان فايل مدتي طول مي كشد و تو اين مدت دستورات بعدي سريع اجرا مي شوند كه ممكن است نتيجه اش به اجاي فايل بستگي داشته با شه.اسليپ باعث ميشه به ويندوز فرصت بدي ساير دستورات فرستاده شده به خارج برنامه رو اجرا كنه. البته گاهي اوقات هم نميدونيم چند ثانيه مكث كنيم و ممكنه مجبور شيم براي احتياط زمان زيادي مكث كنيم كه سرعت برنامه مياد پايين پس تا مي تونيم از دستورات خود وي بي استفاده كنيم تا بر نامه هاي خارجي.ِ
Shell دستور
توسط اين دستور مي تونيد فايلي را در وي بي اجرا كنيد .آدرسي كه جلوي اين دستور نوشته مي شه اجرا ميشه .شكل اين دستور به اين صورت است:ِ
Shell ProgramPath,RunModel
در آرگومان اول مسير فايل نوشته مي شود ودر آرگومان دوم مدلي كه برنامه بايد اجرا شود.در اين ارگومان از آرگومان هاي زير استفاده مي گردد
vbHide=0 vbMaximizedFocus=1 vbMinimizedFocus=2 vbMinimizedNoFocus=3 vbNormalFocus=4 vbNormalNoFocus=5
در مدل صفر برنامه به صورت پنهان ظاهر مي شود.براي مواقعي كه مي خواهيم عمل اجرا را از ديد كاربر پنهان كنيم .در مدل 2 برنامه اجرا مي شود به صورت كمينه(روي منوي استارت-مينيمايز شده)وفاكس هم روي ان مي رود يعني اين كه بعد از اجرا هي زرد و آبي مي شود تا كار بر روي آن كليك كند.مدل 3برنامه به
صورت ينيمايز -كمينه اجرا مي شود زرد وآبي نمي شود (معمولي-فاكس رويش نمي رود).مدل 1برنامه به صورت تمام صفحه اجرا شده فاكس هم روي آن مي رود(زرد و ابي مي شود).در مدل 4برنامه با اندازه پيش فرض اجرا مي شودوفاكس را هم مي گيرد.درمدل 5برنامه با اندازه معمولي اجرا شده و فاكس نمي گيرد
كار برد مهم ديگر شل اجرا فايل هاي معمولي با يك برنامه اجرايي است مثل اجراي يك متن در نت پد.براي اين كار نام فايل را بايك فاصله از نام فايل مي نويسيم
Shell "NotPath.Exe"+" C:\Text1.txt" ,4
نظرات شما عزیزان:
موضوعات مرتبط: آموزش ، ،
برچسب‌ها:
خبرنامه وب سایت:
آمار
وب سایت:
